1 REM *PROGRAM NAME IS ACCTSR/T* 2 POKE45,PEEK(174):POKE46,PEEK(175):CLR 3 HF$="ACCTSR/X":REM HASH FILE 4 MS= 100 :REM *NUMBER OF RECORDS 5 KF= 1 :RS= 192 7 DF$="ACCTSR0/D":REM DATA FILE NAME 8 SF$="ACCTSR/S":REM SCREEN FILE 10 GOSUB52210:GOSUB 33000 20 Y$="" 21 SS$="":FORI=1TO80:SS$=SS$+CHR$(160):NEXTI 22 SP$="":FORI=1TO39:SP$=SP$+CHR$(32):NEXT I 25 DT$="":FORI=1TO39:DT$=DT$+CHR$(46):NEXT I 30 PRINTCHR$(14) 35 REM 37 DIM F$(NF),G$(NF),DT%(12),GS%(NF+NC) 40 FORI=1TONG:READGK%:GS%(GK%)=I:NEXTI 42 DATA 16 52 FOR I=1TO12:DT%(I)=31:NEXTI 54 DT%(2)=29:DT%(4)=30:DT%(6)=30:DT%(9)=30:DT%(11)=30 55 TT$="[198]INISHED WITH ENTRY? ([210][197][212][213][210][206]=NO)" 68 GOSUB13000:REM GET GLOBALS FROM /GLB FILE 70 OPEN2,8,2,"0:"+HF$+",L,"+CHR$(5) 71 INPUT#2,NR$:NR=VAL(NR$):INPUT#2,NXR$:INPUT#2,XFS$:INPUT#2,XFS$:CLOSE2 72 PQ=1:IF ASC(NR$)=255 THEN PQ=0 80 DIM CS%(NC):FORI=1TONC:READCS%(I):NEXTI 82 DATA 0 89 PRINT"[147]":GOSUB800:GOSUB55100 90 POKE 808,237:FOR I=1 TO NF:G$(I)="":F$(I)="":NEXT I:FC=0:UF=0 95 PRINTCHR$(147);CHR$(8):G$="":FORI=1TONC:CE(I)=0:CD(I)=0:NEXTI 100 PRINTTAB(20-(9+ 13 /2));"[208]ROGRAM [196]ESIGN BY [212]HE [195]OMPUCATS" 110 PRINT:PRINTTAB(20-( 21 /2));" [193][195][195][207][213][206][212][211][160][210][197][195][197][201][214][193][194][204][197] [146]" 120 PRINT:PRINT:PRINT 130 PRINTTAB(1);"[198]ILE [208]REPARATION (FIRST TIME ONLY!). F" 140 PRINT 150 PRINTTAB(1);"[197]NTER DATA ......................... E" 160 PRINTTAB(1);"[213]PDATE DATA ........................ U" 170 PRINTTAB(1);"[204]OOK UP RECORD ..................... L" 180 PRINTTAB(1);"[211]EARCH RECORDS...................... S" 190 PRINTTAB(1);"[196]ELETE RECORD ...................... D" 195 PRINTTAB(1);"[214]ERIFY GLOBAL TOTALS ............... V" 197 PRINTTAB(1)"[211]ET DISPLAY COLORS ................. Z" 200 PRINT 210 PRINTTAB(1);"[197]XIT ...(AFTER [197][193][195][200] SESSION)........ X" 215 PRINT LEFT$(Y$,21); 220 PRINT"[197]NTER YOUR CHOICE THEN PRESS [210][197][212][213][210][206][146]"; 230 PRINTLEFT$(Y$,23)"[212]O RETURN TO THE MENU PRESS F1[146] " 235 C3=PEEK(56128)AND15 240 X%=38:Y%=21:L%=1:GOSUB 34000:AN$=IN$:FF$=IN$ 250 IF AN$="E" THEN GOSUB 1000:GOTO90 255 IF AN$="Z" THEN GOSUB 53000:GOTO90 260 IF AN$="L" THEN GOSUB 10000:GOTO90 270 IF AN$="S"THEN GOSUB 35000:GOTO90 280 IF AN$="U"THEN GOSUB 11000:GOTO90 290 IF AN$="D"THEN GOSUB 12000:GOTO90 300 IF AN$="F"THEN GOSUB 32000:GOTO90 305 IF AN$="V"THEN GOSUB 13200:GOTO90 310 IF AN$<>"X"THEN 90 315 IF PQ=0THENPRINT"[147]":GOSUB1002:GOTO90 320 GOSUB 9700:PRINT"[147]":REM UPDATE INDEX FILE PTRS 322 OPEN4,8,4,"MENU":GOSUB52220:CLOSE4:IF DS=0THEN 330 324 CLOSE15:PRINTCHR$(9):END 330 PRINT"[147] *** [204]OADING [205]ENU [208]ROGRAM[146] ***":LOAD"MENU",8:END 800 PRINT:PRINT:PRINT TAB(5);"********* [215][193][210][206][201][206][199][160]*********" 805 PRINT:PRINT" [212]O PREVENT THE LOSS OF YOUR FILES," 810 PRINT"[193]LWAYS TAKE THE X-OPTION BEFORE LEAVING." 815 PRINTLEFT$(Y$,23):PRINT" [208]RESS [210][197][212][213][210][206][146] TO CONTINUE" 820 GET AA$:IF AA$=""THEN 820 825 RETURN 1000 PRINT CHR$(147) 1001 IF PQ=1 THEN 1010 1002 PRINT"[212]HE DATA FILES MUST BE INITIALIZED." 1003 PRINT"[208]LEASE SELECT THE FILE PREPARATION OPTION." 1005 PRINTLEFT$(Y$,24)"[208]LEASE [208]RESS [210][197][212][213][210][206][146] TO CONTINUE" 1006 GET AA$:IF AA$<>CHR$(13) THEN 1006 1007 RETURN 1010 IF NRCHR$(13) THEN 1040 1045 RETURN 1050 FORI=1 TO NF:SD$=LEFT$(DT$,L%(I)) 1053 IFT$(I)="D"THENSD$="../../.." 1056 PRINTLEFT$(Y$,Y%(I));TAB(X%(I));PR$(I);SD$ 1060 NEXT I 1061 IFNT=<0THEN1065 1062 FOR I=1 TO NT 1063 PRINTLEFT$(Y$,TY%(I));TAB(TX%(I)+1);TP$(I) 1064 NEXT I 1065 REM 1080 FC=FC+1 1082 IF FC<= 0 OR FC> 6 THEN 1086 1084 ON FC- 0 GOSUB 2010, 2060, 2110, 2160, 2210, 2260 1086 IF FC<= 6 OR FC> 12 THEN 1090 1088 ON FC- 6 GOSUB 2310, 2360, 2400, 2440, 2490, 2540 1090 IF FC<= 12 OR FC> 15 THEN 1094 1092 ON FC- 12 GOSUB 2600, 2660, 2720 1094 IF IN$=CHR$(133) THEN RETURN 1095 IF GS%(FC)>0 THEN GK(GS%(FC))=GL(GS%(FC))+VAL(G$(FC)) 1140 PRINTLEFT$(Y$,23);SP$ 1142 IF FC< 15 THEN 1080 1160 PRINTLEFT$(Y$,24);SP$; 1170 PRINTLEFT$(Y$,24);"[201]S THIS ALL CORRECT? ( [210][197][212][213][210][206][146] = YES )"; 1180 X%=38:Y%=24:L%=1:GOSUB 34000:PRINTLEFT$(Y$,23);SP$:PRINTSP$; 1190 IFLEN(IN$)=0ORIN$="Y" THEN 2780 1195 IF IN$<>"N"THEN1170 1200 PRINTLEFT$(Y$,23);"[215]HICH FIELD TO CHANGE? ":PRINT"(1 - 15 OR 'LIST')"; 1210 X%= 18 :Y%=24:L%=4:GOSUB34000:IN=VAL(IN$) 1220 IF IN$="LIST" THEN F=1:GOSUB20000:GOSUB21000:GOTO 1200 1230 IFIN<1ORIN> 15 THEN PRINTLEFT$(Y$,23);SP$:PRINTLEFT$(Y$,23);"[201]NVALID FIELD #":GOTO 1160 1240 PRINTLEFT$(Y$,23);SP$:PRINTSP$ 1250 IF IN<= 0 OR IN> 6 THEN 1254 1252 ON IN- 0 GOSUB 2010, 2060, 2110, 2160, 2210, 2260 1254 IF IN<= 6 OR IN> 12 THEN 1258 1256 ON IN- 6 GOSUB 2310, 2360, 2400, 2440, 2490, 2540 1258 IF IN<= 12 OR IN> 15 THEN 1262 1260 ON IN- 12 GOSUB 2600, 2660, 2720 1262 IFIN$=CHR$(133)THENRETURN 1272 IFGS%(IN)>0 THEN GK(GS%(IN)) = GL(GS%(IN)) +VAL(G$(IN)) 1282 GOTO1160 2010 X%=X%( 1)+LEN(PR$( 1)):Y%=Y%( 1):L%=L%( 1) 2011 IFUF<>0ANDG$=""THENG$=G$( 1) 2020 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 1)=IN$:IFG$( 1)=CHR$(133)THEN RETURN 2030 IF UF<>0 AND LEN(IN$)=0 THEN G$( 1)=G$ 2040 IFLEN(G$( 1))0ANDG$=""THENG$=G$( 2) 2070 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 2)=IN$:IFG$( 2)=CHR$(133)THEN RETURN 2080 IF UF<>0 AND LEN(IN$)=0 THEN G$( 2)=G$ 2090 IFLEN(G$( 2))0ANDG$=""THENG$=G$( 3) 2120 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 3)=IN$:IFG$( 3)=CHR$(133)THEN RETURN 2130 IF UF<>0 AND LEN(IN$)=0 THEN G$( 3)=G$ 2140 IFLEN(G$( 3))0ANDG$=""THENG$=G$( 4) 2170 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 4)=IN$:IFG$( 4)=CHR$(133)THEN RETURN 2180 IF UF<>0 AND LEN(IN$)=0 THEN G$( 4)=G$ 2190 IFLEN(G$( 4))0ANDG$=""THENG$=G$( 5) 2220 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 5)=IN$:IFG$( 5)=CHR$(133)THEN RETURN 2230 IF UF<>0 AND LEN(IN$)=0 THEN G$( 5)=G$ 2240 IFLEN(G$( 5))0ANDG$=""THENG$=G$( 6) 2270 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 6)=IN$:IFG$( 6)=CHR$(133)THEN RETURN 2280 IF UF<>0 AND LEN(IN$)=0 THEN G$( 6)=G$ 2290 IFLEN(G$( 6))0ANDG$=""THENG$=G$( 7) 2320 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 7)=IN$:IFG$( 7)=CHR$(133)THEN RETURN 2330 IF UF<>0 AND LEN(IN$)=0 THEN G$( 7)=G$ 2340 IFLEN(G$( 7))0ANDG$=""THENG$=G$( 8) 2370 GOSUB49000:PRINTLEFT$(Y$,23);SP$:G$( 8)=IN$:IFG$( 8)=CHR$(133)THEN RETURN 2380 IF UF<>0 AND LEN(IN$)=0 THEN G$( 8)=G$ 2390 RETURN 2400 X%=X%( 9)+LEN(PR$( 9)):Y%=Y%( 9):L%=L%( 9) 2401 IFUF<>0ANDG$=""THENG$=G$( 9) 2410 GOSUB49000:PRINTLEFT$(Y$,23);SP$:G$( 9)=IN$:IFG$( 9)=CHR$(133)THEN RETURN 2420 IF UF<>0 AND LEN(IN$)=0 THEN G$( 9)=G$ 2430 RETURN 2440 X%=X%( 10)+LEN(PR$( 10)):Y%=Y%( 10):L%=L%( 10) 2441 IFUF<>0ANDG$=""THENG$=G$( 10) 2450 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 10)=IN$:IFG$( 10)=CHR$(133)THEN RETURN 2460 IF UF<>0 AND LEN(IN$)=0 THEN G$( 10)=G$ 2470 IFLEN(G$( 10))0ANDG$=""THENG$=G$( 11) 2500 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 11)=IN$:IFG$( 11)=CHR$(133)THEN RETURN 2510 IF UF<>0 AND LEN(IN$)=0 THEN G$( 11)=G$ 2520 IFLEN(G$( 11))0ANDG$=""THENG$=G$( 12) 2550 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 12)=IN$:IFG$( 12)=CHR$(133)THEN RETURN 2560 IF UF<>0 AND LEN(IN$)=0 THEN G$( 12)=G$ 2561 IFUF=0 THEN 2564 2562 B$=G$( 12):A$="M":GOSUB41000:G1=I9 2563 IFG1>0THENGG=VAL(G$( 12))+VAL(G$):G$( 12)=STR$(GG) 2564 IFUF=0THEN 2570 2565 B$=G$( 12):A$="L":GOSUB41000:G1=I9 2566 IFG1>0THENGG=VAL(G$)-VAL(G$( 12)):G$( 12)=STR$(GG) 2570 G$( 12)=STR$(VAL(G$( 12))) 2575 IF VAL(G$( 12))>=0 THENG$( 12)=RIGHT$(G$( 12),LEN(G$( 12))-1) 2580 IFLEN(G$( 12))0ANDG$=""THENG$=G$( 13) 2610 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 13)=IN$:IFG$( 13)=CHR$(133)THEN RETURN 2620 IF UF<>0 AND LEN(IN$)=0 THEN G$( 13)=G$ 2621 IFUF=0 THEN 2624 2622 B$=G$( 13):A$="M":GOSUB41000:G1=I9 2623 IFG1>0THENGG=VAL(G$( 13))+VAL(G$):G$( 13)=STR$(GG) 2624 IFUF=0THEN 2630 2625 B$=G$( 13):A$="L":GOSUB41000:G1=I9 2626 IFG1>0THENGG=VAL(G$)-VAL(G$( 13)):G$( 13)=STR$(GG) 2630 G$( 13)=STR$(VAL(G$( 13))) 2635 IF VAL(G$( 13))>=0 THENG$( 13)=RIGHT$(G$( 13),LEN(G$( 13))-1) 2640 IFLEN(G$( 13))0ANDG$=""THENG$=G$( 14) 2670 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 14)=IN$:IFG$( 14)=CHR$(133)THEN RETURN 2680 IF UF<>0 AND LEN(IN$)=0 THEN G$( 14)=G$ 2681 IFUF=0 THEN 2684 2682 B$=G$( 14):A$="M":GOSUB41000:G1=I9 2683 IFG1>0THENGG=VAL(G$( 14))+VAL(G$):G$( 14)=STR$(GG) 2684 IFUF=0THEN 2690 2685 B$=G$( 14):A$="L":GOSUB41000:G1=I9 2686 IFG1>0THENGG=VAL(G$)-VAL(G$( 14)):G$( 14)=STR$(GG) 2690 G$( 14)=STR$(VAL(G$( 14))) 2695 IF VAL(G$( 14))>=0 THENG$( 14)=RIGHT$(G$( 14),LEN(G$( 14))-1) 2700 IFLEN(G$( 14))0ANDG$=""THENG$=G$( 15) 2730 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 15)=IN$:IFG$( 15)=CHR$(133)THEN RETURN 2740 IF UF<>0 AND LEN(IN$)=0 THEN G$( 15)=G$ 2741 IFUF=0 THEN 2744 2742 B$=G$( 15):A$="M":GOSUB41000:G1=I9 2743 IFG1>0THENGG=VAL(G$( 15))+VAL(G$):G$( 15)=STR$(GG) 2744 IFUF=0THEN 2750 2745 B$=G$( 15):A$="L":GOSUB41000:G1=I9 2746 IFG1>0THENGG=VAL(G$)-VAL(G$( 15)):G$( 15)=STR$(GG) 2750 G$( 15)=STR$(VAL(G$( 15))) 2755 IF VAL(G$( 15))>=0 THENG$( 15)=RIGHT$(G$( 15),LEN(G$( 15))-1) 2760 IFLEN(G$( 15)) 0 THEN GK(IJ)=GL(IJ)+CD(PZ) 2820 NEXT PZ 9000 REM ==== LOOK FOR RECORD SPACE ==== 9200 ZZ$=G$(KF):GOSUB26000:REM COMPUTE HASH KEY FOR REC. ENTERED 9300 GOSUB52100:GOSUB52135:REM POSITION TO HASH FILE & READ PTR TO LINKED LIST 9310 HPTR$=IK$:HKEY=RP:REM SAVE OLD LINK PTR 9325 RP=HKEY:GOSUB52100:IK$=XFS$:GOSUB52145:REM WRITE HASH LINK FOR NEW ENTRY 9330 RP=VAL(XFS$):GOSUB42000:REM WRITE DATA REC TO 0/D 9335 RP=RP+MS+4:GOSUB52100:GOSUB52135:DRP$=IK$:REM READ DEL REC LINKED LIST PTR 9340 GOSUB52100:IK$=HPTR$:GOSUB52145:REM WRITE LINK DATA REC LINK PTR 9350 IF ASC(DRP$)=255THEN GOTO9360 9355 XFS$=DRP$:GOTO9372:REM SET FREE SPACE PTR TO FREE-DEL-REC LINKED LIST PTR 9360 XFS$=NXR$:NXR$=STR$(VAL(NXR$)+1):REM UPDATE FREE & CONTIGUOUS SPACE PTRS. 9372 IF AN$="U" THEN RETURN 9375 NR=NR+1 9400 RM=MS-NR 9410 PRINTLEFT$(Y$,23);"[210]EC. ENTERED:";MID$(STR$(NR),2); 9420 PRINT" [210]EC. SPACES LEFT:";MID$(STR$(RM),2) 9430 IFRM=0THENPRINTLEFT$(Y$,23);SP$; 9440 IF RM=0 THENPRINTLEFT$(Y$,23);TAB(6);" [198][201][204][197] [198][213][204][204] [146]" 9450 PRINT"[208]RESS [210][197][212][213][210][206][146] TO CONTINUE." 9460 GET AA$:IF AA$<>CHR$(13) THEN 9460 9470 PRINTLEFT$(Y$,23);SP$ 9480 IF RM=0 THEN RETURN 9490 PRINTLEFT$(Y$,24);SP$:PRINTLEFT$(Y$,24);TT$ 9500 X%=LEN(TT$)+1:Y%=24:L%=1:GOSUB34000 9520 IF LEFT$(IN$,1)="Y" THEN GOSUB9700:RETURN 9530 IF LEN(IN$)=0 OR IN$="N"THEN 9550 9540 PRINTLEFT$(Y$,23);"[208]LEASE ANSWER Y OR N ([210][197][212][213][210][206][146]=NO)":GOTO 9490 9550 G$="":FC=0:PRINT"[147]":UF=0:GOTO 1000 9700 REM ==== UPDATE INDEX FILE PTRS ==== 9701 PRINT"[147] *** [213]PDATING [201]NDEX [198]ILE[146] ***" 9710 IK$=NXR$:RP=2:GOSUB52100:GOSUB52145:REM WRITE NEXT CONT. REC. PTR. 9720 IK$=XFS$:RP=4:GOSUB52100:GOSUB52145:REM WRITE NEXT FREE SPC PTR 9730 IK$=STR$(NR):RP=1:GOSUB52100:GOSUB52145:REM UPDATE REC COUNT 9740 RETURN 10000 PRINT "[147]" 10010 GOSUB 27000:REM PROMPT FOR HASH KEY 10015 IF IN$=CHR$(133)THEN RETURN 10020 IF ASC(IK$)<>255 THEN 10050 10030 GOSUB 27110:REM REC NOT FOUND PROMPT 10040 RETURN:REM RETURN TO MENU 10050 RP=IK:GOSUB40000:REM INPUT DATA REC 10055 IF LEFT$(F$(KF),LEN(ZZ$))<>ZZ$ THEN10090 10060 GOSUB29000:GOSUB29180:REM DISPLAY REC & PRMPT 10065 IF LEN(IN$)=0 OR IN$="Y" THEN GOTO10070 10068 GOTO10090 10070 GOSUB29220:REM PROMPT TO CONT 10080 IFIN$="X"THEN RETURN 10090 RP=IK+MS+4:GOSUB52100:GOSUB52135:REM READ LINK POINTER 10100 IFASC(IK$)<>255THEN10050:REM CONT SEARCH 10110 GOSUB27110:REM REC NOT FOUND PROMPT 10120 RETURN 11000 REM ==== FILE UPDATE ROUTINE ==== 11005 PRINT "[147]" 11010 GOSUB 27000:REM PROMPT FOR HASH KEY 11015 IF IN$=CHR$(133)THEN RETURN 11020 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM EXIT IF EMPTY 11030 HPTR=IK:HKEY=RP:REM SAVE HASH POINTER & KEY 11040 RP=IK:GOSUB40000:REM GET DATA REC 11050 RP=IK+MS+4:GOSUB52100:GOSUB52135:REM READ FILE LINK PTR IN /Y 11055 DRP$=IK$:REM SAVE DEL REC PTR 11058 IF LEFT$(F$(KF),LEN(ZZ$))<>ZZ$ THEN GOTO11080 11060 GOSUB 29000:GOSUB29180:REM DISPLAY REC & PROMPT 11070 IF LEN(IN$)=0 OR IN$="Y" THEN GOTO11800 11080 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM REC NOT FOUND 11090 GOTO 11030:REM RESUME SEARCH 11800 FOR I=1 TO NF:G$(I)=F$(I):NEXT I:GOTO11812 11810 GOSUB28000:REM COMPUTE GLB & PC'S 11811 GOSUB29000:REM DISPLAY RECORD 11812 PRINTLEFT$(Y$,23);"[215]HICH FIELD TO UPDATE? (1-";NF;" OR LIST)" 11815 PRINT"([212]YPE F1[146] TO CANCEL,[210][197][212][213][210][206][146] TO SAVE)" 11820 X%= 35 :Y%=24:L%=4:GOSUB 34000 11823 UF=VAL(IN$):IF IN$=""THEN 11950 11824 IF IN$<>CHR$(133) THEN 11828 11825 REM === CLEAR CHANGES === 11826 FOR I=1TONF:G$(I)=F$(I):NEXTI:FORI=1TONC:CD(I)=CE(I):NEXTI 11827 FOR I=1TONG:GK(I)=GL(I):NEXTI: GOTO11811 11828 IF IN$="LIST"THEN F=0 : GOSUB 20000:GOTO 11811 11829 REM === TEST 1 <= UF <= NF === 11830 IF UF>0 AND UF <=NF THEN 11850 11840 PRINT LEFT$(Y$,23);SP$:PRINT SP$ 11845 PRINT LEFT$(Y$,23);"*[201]NVALID FIELD*":FORI=1TO1000:NEXT:GOTO11812 11850 REM === CHANGE FIELD === 11852 SD$=LEFT$(DT$,L%(UF)):IF T$(UF)<>"$" THEN 11855 11853 LD%=0- L%(UF):IF LD% > 0 THEN SD$=SD$+LEFT$(SP$,LD%) 11855 IF T$(UF)="D" THEN SD$="../../.." 11857 PRINTLEFT$(Y$,Y%(UF));TAB(X%(UF));PR$(UF);SD$ 11858 G$="" 11860 IF UF<= 0 OR UF> 6 THEN 11864 11862 ON UF- 0 GOSUB 2010, 2060, 2110, 2160, 2210, 2260 11864 IF UF<= 6 OR UF> 12 THEN 11868 11866 ON UF- 6 GOSUB 2310, 2360, 2400, 2440, 2490, 2540 11868 IF UF<= 12 OR UF> 15 THEN 11872 11870 ON UF- 12 GOSUB 2600, 2660, 2720 11872 GOTO 11810 11950 Z$=G$(1) 11960 GOSUB 12105:REM DEL OLD REC AT XPT 11970 G$(1)=Z$ 11980 GOSUB9200:REM ENTER NEW REC 11990 RETURN 12000 REM ==== RECORD DELETE ROUTINE ==== 12005 PRINT "[147]" 12010 GOSUB 27000:REM PROMPT FOR HASH KEY 12015 IF IN$=CHR$(133)THEN RETURN 12020 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM EXIT IF EMPTY 12030 HPTR=IK:HKEY=RP:REM SAVE HASH POINTER & KEY 12040 RP=IK:GOSUB40000:REM GET DATA REC 12050 RP=IK+MS+4:GOSUB52100:GOSUB52135:REM READ FILE LINK PTR IN /Y 12055 DRP$=IK$:REM SAVE DEL REC PTR 12058 IF LEFT$(F$(KF),LEN(ZZ$))<>ZZ$ THEN GOTO12080 12060 GOSUB 29000:GOSUB29180:REM DISPLAY REC & PROMPT 12070 IF IN$="Y" OR LEN(IN$)=0 THEN 12095 12080 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM REC NOT FOUND 12090 GOTO 12030 12095 GOSUB 12800:REM DISPLAY PRMPT TO DELETE 12098 IF IN$="N" THEN RETURN 12100 NR=NR-1:RM=RM+1:REM UPDATE #REC & SPACE LEFT 12105 G$(1)=LEFT$(CHR$(255)+SS$,L%(1)):RP=HPTR:GOSUB42000:REM NULL DATA REC 12108 RP=HPTR+MS+4:GOSUB52100:IK$=XFS$:GOSUB52145:REM MOVE XFS TO DRL 12110 XFS$=STR$(HPTR):REM SET XFS TO DRP 12120 RP=HKEY:GOSUB52100:IK$=DRP$:GOSUB52145:REM MOVE LINK PTR TO HASH TABLE 12190 RETURN 12800 PRINTLEFT$(Y$,24);SP$; 12802 PRINTLEFT$(Y$,24);"[211]URE YOU WANT TO DELETE IT? (Y/N)" 12805 Y%=24:X%=34:L%=1:GOSUB34000 12820 IF IN$<>"Y"AND IN$<>"N"THEN 12800 12830 RETURN 12999 REM ==== GLOBAL TOTAL INPUT ROUTINE ==== 13000 OPEN3,8,3,"0:ACCTSR/GLB,L,"+CHR$(15) 13005 FOR II=1TONG 13010 INPUT#3,GL$ 13020 GL(II)=VAL(GL$) 13030 NEXTII 13040 CLOSE3:RETURN 13096 REM 13097 REM ==== GLOBAL TOTAL UPDATE ROUTINE ==== 13098 REM == W9 IS THE DATA FILE'S FIELD NUMBER == 13099 REM == IJ IS FIELD NUMBER OF THE CORRESPONDING GLOBAL TOTAL == 13100 OPEN3,8,3,"0:ACCTSR/GLB,L,"+CHR$(15) 13102 FOR W9=1TONF 13105 IJ = GS%(W9) 13110 IFIJ = 0THEN13135 : REM NO GLOBAL FIELD 13115 GOSUB52150 13118 IFAN$="U"THEN GL(IJ)=GK(IJ):GOTO13130 13120 IFAN$="D"THEN GL(IJ) = GL(IJ) - VAL(F$(W9)) 13125 IFAN$="E"THEN GL(IJ) = GL(IJ) + VAL(G$(W9)) 13130 PRINT#3,STR$(GL(IJ)) 13135 NEXTW9 13140 FOR W9=1TONC 13145 IJ = GS%(W9+NF) 13150 IFIJ = 0THEN13175 : REM NO GLOBAL FIELD 13155 GOSUB52150 13158 IFAN$="U"THEN GL(IJ)=GK(IJ):GOTO13170 13160 IFAN$="D"THEN GL(IJ) = GL(IJ) - CE(W9) 13165 IFAN$="E"THEN GL(IJ) = GL(IJ) + CD(W9) 13170 PRINT#3,STR$(GL(IJ)) 13175 NEXTW9 13180 CLOSE3:RETURN 13198 REM 13199 REM ==== VERIFY ALL GLOBAL VARIABLES ==== 13200 REM == GENERATOR WILL KNOW WHICH TOTALS ARE THE GLOBAL ONES == 13203 PRINTCHR$(147);LEFT$(Y$,5)"[214]ERIFICATION WILL TAKE A LITTLE WHILE" 13205 FORII=1TONG 13210 GM(II) = 0 : GK(II) = GL(II) 13212 NEXTII 13215 FOR RP=1TOVAL(NXR$)-2 13220 GOSUB 40005:REM NEXT RECORD 13225 IFLEFT$(F$(1),1) = CHR$(255)THEN13255 13230 FOR IJ=1TONF 13240 IFGS%(IJ) > 0THENGM(GS%(IJ)) = GM(GS%(IJ))+VAL(F$(IJ)) 13250 NEXTIJ 13255 NEXTRP 13257 FORII=1TONG 13260 GL(II) = GM(II) 13270 NEXTII 13275 FOR IJ=1TONC 13280 JK =GS%(IJ+NF) 13285 IFJK = 0THEN13350 13290 FOR RP=1TOVAL(NXR$)-2 13300 GOSUB 40005 13310 IFLEFT$(F$(1),1) = CHR$(255)THEN13340 13320 FOR PZ=1TOIJ:GOSUB28500:NEXTPZ 13330 GM(JK) = GM(JK) + CE(IJ) 13340 NEXTRP 13345 GL(GS%(IJ+NF)) =GM(GS%(IJ+NF)) 13350 NEXTIJ 13360 PRINTCHR$(147);LEFT$(Y$,3); 13365 PRINT"[198]IELD";TAB(15);"[207]LD [212]OTAL";TAB(25);"[214]ERIFIED [212]OTAL": PRINT 13370 FOR IJ=1TONG 13380 PRINTGP$(IJ);TAB(15);GK(IJ);TAB(25);GM(IJ) 13390 IFGK(IJ) = GM(IJ)THEN13430 13400 PRINT"* OLD TOTAL CORRECTED *"; 13410 OPEN3,8,3,"0:ACCTSR/GLB,L,"+CHR$(15): 13420 GOSUB52150:PRINT#3,GL(IJ):CLOSE3 13430 PRINT 13440 NEXTIJ 13445 PRINTLEFT$(Y$,24);"[208]RESS [210][197][212][213][210][206][146] TO CONTINUE" 13448 GET AA$:IFAA$<>CHR$(13)THEN13448 13450 RETURN 13460 REM 19999 REM ==== LIST FIELD NUMBERS ==== 20000 PRINT"[147][203]EYBOARD-ENTERED FIELDS:":FOR J=1 TO NF STEP 2 20010 PRINT J;"- ";PR$(J); 20020 IFJ2THEN20260 20210 PRINT:PRINT"[208]ROGRAM [195]ALCULATED [198]IELDS" 20220 FORJ=1TONCSTEP2 20230 PRINTJ+NF;"- ";CP$(J); 20240 IFJCHR$(13) THEN 20600 20610 PRINTCHR$(147) : RETURN 21000 FOR I=1 TO NF:IFT$(I)<>"D"THEN SD$=G$(I):GOTO 21020 21010 SD$=LEFT$(G$(I),2)+"/"+MID$(G$(I),3,2)+"/"+RIGHT$(G$(I),2) 21020 PRINTLEFT$(Y$,Y%(I));TAB(X%(I));PR$(I);SD$:NEXT I 21030 RETURN 21040 SD$=STR$(CD(I)) 21050 PRINTLEFT$(Y$,CY%(I));TAB(CX%(I));CP$(I);SD$; 21060 NEXTI 21062 FOR I=1 TO NT 21064 PRINT LEFT$(Y$,TY%(I))TAB(TX%(I)+1)TP$(I) 21066 NEXT I 21070 RETURN 26000 X=0:FOR ZZ=1 TO LEN(ZZ$) 26010 X=X+ZZ*ASC(MID$(ZZ$,ZZ,1)) 26020 NEXT ZZ 26030 X=LOG(X):X$=STR$(X):RP=VAL(MID$(X$,6,4)) 26040 RP=INT(MS*RP/10000)+5 26050 RETURN 27000 PRINT"[147]":SD$=LEFT$(DT$,L%( KF )):IFT$( KF )="D"THENSD$="../../.." 27010 PRINTLEFT$(Y$,Y%( KF ));TAB(X%( KF ));PR$( KF );SD$ 27020 PRINTLEFT$(Y$,24);"[208]LEASE ENTER KEY OF DESIRED RECORD." 27030 GOSUB2010 27031 IF IN$=CHR$(133)THEN RETURN 27050 ZZ$=G$(KF):GOSUB 26000:REM COMPUTE HASH KEY 27070 GOSUB52100:GOSUB52135:REM READ HASH POINTER 27080 RETURN 27110 REM = DISPLAY REC NOT FOUND PROMPT = 27125 PRINTLEFT$(Y$,24);SP$; 27130 PRINTLEFT$(Y$,23)"[210]ECORD NOT FOUND - [212]YPE [210][197][212][213][210][206][146] TO EXIT." 27140 GET AA$:IF AA$<>CHR$(13) THEN 27140 27150 RETURN 28000 FOR II = 1 TO NF 28010 IJ = GS%(II) 28020 IF IJ = 0 THEN 28040 28030 GK(IJ) = GL(IJ) + VAL(G$(II)) - VAL(F$(II)) 28040 NEXT II 28050 FOR II =1 TO NC 28060 PZ = II : GOSUB 28100 28065 IJ = GS%(II+NF) 28070 IF IJ = 0 THEN 28080 28075 GK(IJ) = GL(IJ) + CD(II) - CE(II) 28080 NEXT II 28085 RETURN 28095 REM ==== CALCULATE CD(PZ) ==== 28097 REM ==== ASSUMING CD(1) THRU CD(PZ-1) IS CALCULATED ==== 28100 IF PZ<= 0 OR PZ> 1 THEN 28104 28102 ON PZ- 0 GOSUB 28200 28104 RETURN 28200 CD(1)=VAL(G$(13))+VAL(G$(14))-VAL(G$(15)) 28205 RETURN 28499 REM ==== PUT OLD VALUES IN CE() ==== 28500 REM ==== BASED ON F$(),GL(),CE() ==== 28505 IF CS%(PZ)=1 THEN RETURN 28510 IF PZ<= 0 OR PZ> 1 THEN 28514 28512 ON PZ- 0 GOSUB 28600 28514 RETURN 28600 CE(1) = VAL(F$(13))+VAL(F$(14))-VAL(F$(15)) 28605 RETURN 29000 REM ==== DISPLAY RECORD TO SCREEN & PROMPTS RTN ==== 29004 PRINT CHR$(147) 29005 IFNF=<0THEN29055 29010 FOR I=1 TO NF:D$=G$(I):IF T$(I)<>"D"THEN 29030 29020 D$=LEFT$(G$(I),2)+"/"+MID$(G$(I),3,2)+"/"+RIGHT$(G$(I),2) 29030 IF T$(I)="$"THEN DO$=D$:FW=L%(I):GOSUB 36000:D$=DO$ 29035 IF T$(I)="#" THEN D$=RIGHT$(SP$+D$,L%(I)) 29040 PRINTLEFT$(Y$,Y%(I));TAB(X%(I));PR$(I);D$ 29050 NEXT I 29055 IFNC=<0THEN29085 29060 FOR I=1 TO NC:CD$=STR$(CD(I)) 29065 IF CT$(I)="$"THEN DO$=CD$:FW=CL%(I):GOSUB 36000:CD$=DO$:GOTO 29075 29070 IF" "=LEFT$(CD$,1) THEN CD$=MID$(CD$,2):GOTO 29070 29073 CD$=RIGHT$(SP$+LEFT$(CD$,CL%(I)),CL%(I)) 29075 PRINTLEFT$(Y$,CY%(I));TAB(CX%(I));CP$(I);CD$ 29080 NEXT I 29085 IFNT=<0THEN29115 29090 FOR I=1 TO NT 29100 PRINTLEFT$(Y$,TY%(I));TAB(TX%(I)+1);TP$(I) 29110 NEXT I 29115 IFNG=<0THEN29165 29120 FOR I = 1 TO NG : REM GET GLOBAL INFO 29130 GL$=STR$(GK(I)):IF GT$(I)="$" THEN DO$=GL$:FW=GL%(I):GOSUB36000:GL$=DO$ 29140 IFGT$="#"THENGL$=RIGHT$(SP$+GL$,GL%(I)) 29150 PRINT LEFT$(Y$,GY%(I));TAB(GX%(I));GP$(I);GL$ 29160 NEXT I 29165 RETURN 29180 PRINTLEFT$(Y$,24);"[201]S THIS IT? ( [210][197][212][213][210][206][146] = YES )"; 29190 X%=29:Y%=24:L%=1:GOSUB 34000 29200 RETURN 29220 PRINTLEFT$(Y$,24);"EX[146]IT, [210][197][212][213][210][206][146] FOR NEXT REC.,[198]1[146] TO PRINT";SP$; 29230 GETIN$:IFIN$<>CHR$(13)ANDIN$<>CHR$(133)ANDIN$<>"X" THEN 29230 29245 IF IN$=CHR$(133)THEN GOSUB 51100:GOTO29220 29250 RETURN 29999 REM ==== NUMERIC FIELD EDIT CHECK SUBROUTINE ==== 30000 B$=CD$:A$=CHR$(32):GOSUB41000:CD=I9 30001 IF CD>1 THEN CD$=LEFT$(CD$,CD-1):GOTO 30000 30002 IF CD=1 THEN CD$=MID$(CD$,2):GOTO 30000 30005 FOR ZZ=1 TO LEN(CD$) 30010 IFMID$(CD$,ZZ,1)>="0"ANDMID$(CD$,ZZ,1)<="9" THEN 30020 30015 IFMID$(CD$,ZZ,1)<>"."ANDMID$(CD$,ZZ,1)<>"-" THEN E=1:RETURN 30020 NEXT ZZ 30030 B$=CD$:A$="-":GOSUB41000:I1=I9:B$=MID$(B$,I1+1) 30035 GOSUB 41000:I2=I9:IF I1>0 AND I2>0 THEN E=1:RETURN 30040 B$=CD$:A$=".":GOSUB41000:I1=I9:B$=MID$(B$,I1+1) 30045 GOSUB 41000:I2=I9:IF I1>0 AND I2>0 THEN E=1:RETURN 30050 RETURN 30999 REM ==== ALPHA FIELD EDIT CHECK SUBROUTINE ==== 31000 FOR ZZ=1 TO LEN(CD$) 31010 IF(MID$(CD$,ZZ,1)<="9"ANDMID$(CD$,ZZ,1)>="0") THEN E=1:RETURN 31020 NEXT ZZ 31030 RETURN 32000 PRINT"[147][212]HIS WILL ERASE ALL PREVIOUS RECORDS." 32010 PRINT:PRINT"[212]O CONTINUE TYPE 'C' THEN [210][197][212][213][210][206][146] 32020 X%[178]34:Y%[178]3:L%[178]1:[141] 34000 32030 [139]IN$[179][177]"C" [167] [142] 32040 [153]:[153]"(null)HIS WILL TAKE A LITTLE WHILE." 32045 [152]15,"S0:ACCTSR/X" 32050 [159]1,8,15:[159]2,8,2,"0:ACCTSR/X,L,"[170][199](5) 32055 [152]1,"P"[199](2)[199]( 204 )[199]( 0 )[199](1) 32060 [152]2,[199](255) 32063 RP[178]1:[141]52110 32064 NR$[178][196](0):NXR$[178][196](2):XFS$[178][196](1) 32065 [152]2,NR$:[152]2,NXR$:[152]2,[196]( 15 ):[152]2,XFS$ 32070 [160]1:[160]2:NR[178]0 32085 [152]15,"S0:"[170](DF$):[159]1,8,15 32090 [159]4,8,4,"0:ACCTSR0/D,L,"[170][199](80):JN[178][181](( 192 [172] 100 )[173]80)[170]1 32093 R2[178][181](JN[173]256):R1[178]JN[171]256[172]R2 32095 [152]1,"P"[199](4)[199](R1)[199](R2)[199](1) 32098 [141]52220:[152]4,[199](255):[160]1:[160]4 32100 [159]3,8,3,"0:ACCTSR/GLB,L,"[170][199](15) 32110 [129]I[178]1[164]NG 32120 [152]3,[196](0) 32130 GL(I)[178]0 32140 [130]I 32150 [160]3 32160 PQ[178]1:[142] 33000 [159]4,8,4,"0:"[170]SF$ 33002 [141]52220:[139] DS[178]0 [167] 33010 33004 [153]:[153]"LOAD(null)OUR PROGRAM DISK MUST BE IN DRIVE #0 - (null)RESS (null)VAL(null)(null)(null)(null)WAIT TO CONTINUE 33006 GETAA$:IFAA$<>CHR$(13)THEN33006 33008 CLOSE4:GOTO 33000 33010 INPUT#4,NF:IFNF=<0THEN33060 33020 DIMPR$(NF),X%(NF),Y%(NF),L%(NF),T$(NF) 33030 FOR I=1 TO NF 33040 INPUT#4,PR$(I),X%(I),Y%(I),L%(I),T$(I) 33050 NEXT I 33060 INPUT#4,NC:IFNC=<0THEN33102 33070 DIM CP$(NC),CX%(NC),CY%(NC),CT$(NC),CD(NC),CE(NC),CL%(NC) 33080 FORI=1TONC 33090 INPUT#4,CP$(I),CX%(I),CY%(I),CL%(I),CT$(I) 33100 NEXTI 33102 INPUT#4,NG:IFNG=<0THEN33110 33105 DIM GP$(NG),GX%(NG),GY%(NG),GT$(NG),GL(NG),GK(NG),GM(NG),GL%(NG) 33107 FORI=1TONG:INPUT#4,GP$(I),GX%(I),GY%(I),GL%(I),GT$(I):NEXT I 33110 INPUT#4,NT:IFNT=<0THEN33160 33120 DIM TP$(NT),TX%(NT),TY%(NT) 33130 FORI=1TONT 33140 INPUT#4,TP$(I),TX%(I),TY%(I) 33150 NEXTI 33160 CLOSE4:RETURN 34000 IN$="":J=1:AD=1024+(Y%-1)*40+X%-1 34005 FORKL=0TOL%:POKE55296+(Y%-1)*40+(X%+KL),C3:NEXTKL 34010 IFJ=1ANDL%>1THENPRINTLEFT$(Y$,Y%);TAB(X%);LEFT$(DT$,L%) 34020 POKEAD+J,PEEK(AD+J)OR128 34030 GET I$:IFI$=""THEN 34030 34031 IFI$=CHR$(140)THENGOSUB54300:GOTO34010 34032 II=ASC(I$) 34033 IF I$=CHR$(32) THEN I$=CHR$(160):GOTO34080 34035 IF II=133 THENIN$=I$:RETURN 34036 IF II=34 THEN 34030 34040 IF(II<32ANDII<>20ANDII<>13)OR(II>128ANDII<192)OR(II>218)THEN34010 34041 IFII=59ORII=58ORII=44THEN34010 34045 IF II<>20 THEN 34070 34050 IF J=1 THEN 34010 34060 J=J-1:IN$=LEFT$(IN$,J-1):I$=".":PRINTLEFT$(Y$,Y%);SPC(X%+J);".":GOTO34090 34070 IFII=13THENPOKEAD+J,PEEK(AD+J)AND 127:RETURN 34080 IN$=IN$+I$ 34090 PRINTLEFT$(Y$,Y%);SPC(X%+J-1);I$ 34100 IFJ=L%THENIN$=LEFT$(IN$,J-1)+I$:GOTO54000 34110 IF II<>20 THEN J=J+1 34120 GOTO 34010 34200 REM ==== REMOVE TRAILING BLANKS ==== 34205 IF IN$="" THEN RETURN 34210 CC%=ASC(RIGHT$(IN$,1)) 34220 IF CC%<>32ANDCC%<>160 THEN RETURN 34230 IN$=LEFT$(IN$,LEN(IN$)-1):GOTO34205 35000 POKE808,237:PRINT"[147][211]CAN ALL OR SELECTED RECORDS? (A/S)"; 35010 X%=36:Y%=1:L%=1:GOSUB 34000:ST$=IN$ 35015 IF IN$=CHR$(133) THEN RETURN 35020 IF ST$<>"A" AND ST$<>"S" THEN 35010 35030 IF ST$="A" THEN 35180 35035 PRINTLEFT$(Y$,4) 35040 PRINT"[215]HAT FIELD DO YOU WISH TO SELECT BY?" 35045 PRINT"( 1-";NF+NC;" OR 'LIST' )"; 35050 X%=21:Y%=PEEK(214)+1:L%=5:GOSUB 34000:SF=VAL(IN$) 35060 IF IN$<>"LIST" THEN 35080 35070 F=2:GOSUB20000:PRINT CHR$(147):GOTO35035 35080 IF SF<1ORSF>NF+NC THEN PRINTLEFT$(Y$,9)"INVALID FIELD" 35083 IF SF<1ORSF>NF+NC THEN FOR ZT=1TO1000:NEXTZT 35085 IF SF<1ORSF>NF+NC THEN PRINTLEFT$(Y$,9);SP$:GOTO35035 35090 IF SF<=NF THEN T$=T$(SF) : LS%=L%(SF) : GOTO 35110 35100 T$=CT$(SF-NF) : LS%=CL%(SF-NF) 35110 PRINTLEFT$(Y$,9);"[211]MALLEST ITEM TO SELECT?";:Y0%=PEEK(214)+2 35120 X%=0:Y%=Y0%:L%=LS% 35122 IF T$="D" THEN GOSUB 49000:SM$=IN$:GOTO 35130 35125 GOSUB 34000: GOSUB 34200 : SM$=IN$ 35130 IF SM$="" THEN 35120 35135 IF T$="D" THEN D$=SM$:GOSUB 35500:SM$=D$ 35140 PRINTLEFT$(Y$,12);"[204]ARGEST ITEM TO SELECT?";:Y0%=PEEK(214)+2 35150 X%=0:Y%=Y0%:L%=LS% 35152 IF T$="D" THEN GOSUB 49000:LR$=IN$:GOTO 35160 35155 GOSUB 34000: LR$=IN$ 35160 IF LR$="" THEN 35150 35165 IF T$="D" THEN D$=LR$:GOSUB 35500:LR$=D$ 35170 LR=VAL(LR$):SM=VAL(SM$) 35172 IF (T$="#"ORT$="$")AND LRLR$ OR G$LR THEN 35400 35313 IB%=SF-NF+1 :IFIB%<1THENIB%=1 35315 IFIB%>NCTHEN35330 35320 FORPZ=IB%TONC:GOSUB28500:NEXTPZ 35330 FORIA=1TONC:CD(IA)=CE(IA):NEXTIA 35340 FOR IA=1 TO NF : G$(IA)=F$(IA) : NEXT IA 35350 GOSUB 29000:GOSUB 29220 35380 IF IN$="X"THEN RETURN 35400 NEXT RP 35410 RETURN 35500 D$=RIGHT$(D$,2)+LEFT$(D$,2)+MID$(D$,3,2):RETURN 35999 REM ==== DOLLAR FORMATTING ==== 36000 DO$=STR$(INT(VAL(DO$)*100+0.5)/100):L=LEN(DO$) 36010 FOR J=1 TO L:IF MID$(DO$,J,1)="." THEN 36030 36020 NEXT J:J=J-1 36030 IF J=2 AND L>2 THEN DO$=LEFT$(DO$,1)+"0"+RIGHT$(DO$,L-1) 36040 IF J=L THEN DO$=DO$+".00" 36050 IF J=L-1 THEN DO$=DO$+"0" 36070 DO$=RIGHT$(SP$+DO$,FW) 36080 RETURN 40000 GOSUB 40005 : GOSUB 40150 : RETURN 40005 SN=INT(RS*(RP-1)/80)+1:OS=(RS*(RP-1))-(80*(SN-1)) 40030 GOSUB52000:INPUT#4,IN$:IN$=LEFT$(IN$+SS$,80) 40040 RL=OS:I9=RL+1 40050 FOR J=1 TO NF:IF RL+L%(J)>80 THEN 40065 40055 RL=RL+L%(J):F$(J)=MID$(IN$,I9,L%(J)):I9=I9+L%(J) 40060 GOTO 40090 40065 F$(J)=MID$(IN$,I9,80-RL):SN=SN+1 40070 GOSUB52010:INPUT#4,IN$ 40080 IN$=LEFT$(IN$+SS$,80):F$(J)=F$(J)+LEFT$(IN$,L%(J)+RL-80) 40085 RL=L%(J)-(80-RL):I9=RL+1 40090 NEXT J 40145 CLOSE1:CLOSE4:PRINT#15,"I0":RETURN 40150 FOR II=1TONF:G$(II)=F$(II):NEXT II 40160 FORPZ=1TONC:GOSUB28500:NEXT PZ 40170 FORII=1TONC: CD(II) = CE(II) :NEXTII 40180 FORII=1TONG:GK(II)=GL(II):NEXTII 40190 RETURN 40499 REM ==== ADD TRAILING BLANKS ==== 40500 G$(I)=LEFT$(G$(I)+SS$,L%(I)):RETURN 40999 REM ==== STRING SEARCH ==== 41000 FOR JI=1 TO LEN(B$)+1-LEN(A$) 41010 IF MID$(B$,JI,LEN(A$))=A$ THEN I9=JI:GOTO 41040 41020 NEXT JI 41030 I9=0 41040 RETURN 42000 REM ==== WRITE RECORD TO DATA FILE ==== 42002 GOSUB 13100 : REM UPDATE TOTALS 42005 SN=INT(RS*(RP-1)/80)+1:OS=(RS*(RP-1))-(80*(SN-1)) 42030 GOSUB52000:INPUT#4,IN$:IN$=LEFT$(IN$+SS$,80) 42040 OP$=LEFT$(IN$,OS):RL=OS:I9=RL+1 42050 FOR J=1 TO NF 42053 IF RL+L%(J)>80 THEN 42063 42056 RL=RL+L%(J):OP$=OP$+G$(J) 42060 GOTO 42080 42063 OP$=OP$+LEFT$(G$(J),80-RL):GOSUB52010:PRINT#4,OP$ 42070 SN=SN+1 42073 GOSUB52010:INPUT#4,IN$:IN$=LEFT$(IN$+SS$,80) 42076 OP$=MID$(G$(J),81-RL):RL=L%(J)-(80-RL) 42080 NEXT J 42136 OP$=OP$+MID$(IN$,RL+1):GOSUB52010:PRINT#4,OP$:CLOSE4:CLOSE1 42138 PRINT#15,"I0":RETURN 49000 PRINT LEFT$(Y$,Y%);TAB(X%);"../../.."; 49010 J=1 : IN$="" : AD = 1024+(Y%-1)*40 + X%-1 49020 POKE AD+J,PEEK(AD+J) OR 128 49030 GET J$ : IF J$="" THEN 49030 49040 JJ = ASC(J$) 49045 IF JJ=13 AND J=1 THEN 49085 49050 IF JJ=133 THEN IN$=J$ : RETURN 49070 IF JJ>=48 AND JJ<=57 THEN 49200 49080 IF JJ<>13 THEN 49110 49084 IF IN$<>""THEN49090 49085 IF KF=FC THEN 49030 49086 IN$="000000":PRINTLEFT$(Y$,Y%);TAB(X%+J-1);".":RETURN 49090 IF LEN(IN$)<6 THEN 49030 49100 POKE AD+8,PEEK(AD+8) AND 127 : GOTO 49250 49110 IF JJ<>20 THEN 49160 49120 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);"."; 49125 IF J=1 THEN IN$="":GOTO 49020 49127 IF J=8 THEN IN$=LEFT$(IN$,5) 49130 IN$=LEFT$(IN$,LEN(IN$)-1):J=J-1:IF J=3 OR J=6 THEN J=J-1 49135 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);"."; 49140 GOTO 49020 49160 IF JJ<>32 THEN 49030 49170 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);" "; 49180 IF J=1 OR J=4 OR J=7 THEN J$=CHR$(48) : GOTO 49210 49190 J$ = CHR$(32) : GOTO 49210 49200 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);J$; 49210 IF J=8 THEN IN$=LEFT$(IN$,5) 49220 IN$=IN$+J$ : J=J+1 : IF J=3 OR J=6 THEN J=J+1 49230 IF J=9 THEN J=8 49240 GOTO 49020 49250 XX=VAL(LEFT$(IN$,2)):YY=VAL(MID$(IN$,3,2)):ZZ=VAL(RIGHT$(IN$,2)) 49280 PRINTLEFT$(Y$,23);SP$; 49285 IF(ZZ/4)<>INT(ZZ/4)THENGOSUB49350:IFER=18 THEN ER=0:GOTO49000 49290 IF XX<1 OR XX>12 THEN PRINTLEFT$(Y$,23);"[205]ONTH OUT OF RANGE":GOTO49000 49300 IF YY<1 OR YY>DT%(XX) THENPRINTLEFT$(Y$,23);"[196]AY OUT OF RANGE":GOTO49000 49310 IN$=RIGHT$("00"+MID$(STR$(XX),2),2) 49320 IN$=IN$+RIGHT$("00"+MID$(STR$(YY),2),2) 49330 IN$=IN$+RIGHT$("00"+MID$(STR$(ZZ),2),2) 49340 RETURN 49350 IF XX=2 AND YY=29THENER=18:PRINTLEFT$(Y$,23);"[196]AY OUT OF RANGE" 49360 RETURN 49999 REM ==== TEXT FILE TO BINARY CONVERSION PROGRAM ==== 50000 I=0:PN$="":L=PEEK(828):FORX=1TOL:PN$=PN$+CHR$(PEEK(828+X)):NEXT X 50009 GOSUB32000:OPEN2,8,2,"0:"+(PN$): 50010 POKE152,1:POKE153,8:Q$=CHR$(34) 50020 PP$=LEFT$(PN$,L-2)+"/T" 50030 PRINT"[147]":IF I=0 THEN50050 50040 REM: 50050 FORZ=1 TO9 : FOR Z1=1 TO 80 50060 GET #2,A$:PRINTA$;:IF ST=64THEN 50140 50090 IF A$=CHR$(13)THEN 50100 50095 NEXT Z1 50100 NEXT Z 50110 PRINT"I=";I+9;":L=";L;":PN$=";Q$;PN$;Q$;":GOTO 50010" 50120 POKE 198,11:FORN=0TO9:POKE631+N,13:NEXTN 50130 END 50140 PRINT"PP$=";CHR$(34);PP$;CHR$(34);":GOTO 50160" 50150 POKE 198,Z+1:FORN=0 TOZ:POKE631+N,13:NEXTN 50155 CLOSE2:END 50160 NM$=LEFT$(PP$,LEN(PP$)-2):SF$=NM$+"/S":TF$=NM$+"/B":AF$=NM$+"/PCF" 50161 PN$=NM$+"/T":GOTO60000 51100 PRINTLEFT$(Y$,24);SP$;SP$;LEFT$(Y$,24);"[201]S YOUR PRINTER A [195]OMMODORE?  [146]"; 51102 GETA$:IFA$<>"Y"ANDA$<>"N"ANDA$<>CHR$(13)THEN51102 51104 IFA$=CHR$(13)THEN51108 51106 IN$=A$:PRINTLEFT$(Y$,24);SPC(29);"";IN$;"[146]";:GOTO51102 51108 IFIN$=""THEN51102 51110 IFIN$="Y"THENPOKE832,7:GOTO51120 51112 POKE832,8 51120 CLOSE3:OPEN3,4:PRINT#3,"":IFST<>0THEN51150 51125 PRINTLEFT$(Y$,24);SP$;SP$;LEFT$(Y$,25);"[208]RINTING...."; 51130 SYS828 51135 GOSUB52210:RETURN 51149 REM ==== PRINTER ERROR MSG ROUTINE ==== 51150 PRINTLEFT$(Y$,23)" [208]RINTER [206]OT [210]EADY[146] " 51170 FORX=1TO1200:NEXT 51180 PRINTLEFT$(Y$,23);SP$;:CLOSE3:RETURN 52000 REM ==== POSITION DATA FILE POINTER ==== 52005 OPEN1,8,15:OPEN4,8,4,"0:"+DF$ 52010 R2=INT(SN/256):R1=SN-256*R2 52020 PRINT#1,"P"CHR$(4)CHR$(R1)CHR$(R2)CHR$(1) 52030 RETURN 52100 REM ==== POSITION INDEX FILE POINTER ==== 52105 OPEN1,8,15:OPEN2,8,2,"0:"+HF$ 52110 R2=INT(RP/256):R1=RP-256*R2 52120 PRINT#1,"P"CHR$(2)CHR$(R1)CHR$(R2)CHR$(1) 52130 RETURN 52135 REM ==== READ FROM HASH FILE ==== 52140 INPUT#2,IK$:CLOSE1:CLOSE2:IK=VAL(IK$):RETURN 52145 REM ==== WRITE TO HASH FILE ==== 52147 PRINT#2,IK$:CLOSE1:CLOSE2:RETURN 52150 REM ==== POSITION FORMAT FOR GBL FILE ==== 52160 R2=INT(IJ/256):R1=IJ-256*R2 52170 PRINT#15,"P"CHR$(3)CHR$(R1)CHR$(R2)CHR$(1) 52180 RETURN 52200 REM ==== ERROR CHANNEL OPEN AND INPUT RTNS ==== 52210 OPEN 15,8,15:RETURN 52220 INPUT#15,ER$,EM$,ET$,ES$ 52230 DS=0:DS=VAL(ER$):IFDS=0 THEN RETURN 52240 DS$=ER$+ +EM$+ +ET$+ +ES$ 52250 RETURN 53000 REM ==== SET DISPLAY COLORS ==== 53005 C1=0:C2=0:C3=1 53010 CO$="[144][159][156][158][129][149][150][151][152][153][154][155]" 53015 PRINTCHR$(147)TAB(13)"[211]ET [195]OLOR [205]ODE" 53020 PRINT:PRINT:PRINTTAB(5)"[F1] SETS SCREEN COLOR" 53025 PRINT:PRINTTAB(5)"[F3] SETS BORDER COLOR" 53030 PRINT:PRINTTAB(5)"[F5] SETS TEXT COLOR" 53035 PRINT:PRINTTAB(5)"[F7] RETURNS YOU TO MAIN MENU" 53045 GETAA$:IFAA$=""THEN53045 53050 IFAA$=CHR$(133)THEN53075 53055 IFAA$=CHR$(134)THEN53085 53060 IFAA$=CHR$(135)THEN53095 53065 IFAA$=CHR$(136)THEN RETURN 53070 GOTO53045 53075 C1= C1+1:IFC1>15THENC1=0 53080 POKE53281,C1:GOTO53015 53085 C2= C2+1:IFC2>15THENC2=0 53090 POKE53280,C2:GOTO53015 53095 C3= C3+1:IFC3>17THENC3=1 53100 PRINT MID$(CO$,C3,1):GOTO53015 54000 REM ==== BEEPER ROUTINE ==== 54001 IFSD=1THEN54055 54005 S=54272 54010 POKE S+24,15 54015 POKE S+2,72 54020 FOR X=1 TO 4 54025 : POKE S+1,169: 54030 : POKE S+4,33 54035 REM FOR I=1 TO 5 : NEXT 54040 POKE S+4,4 54045 NEXT X 54050 GOTO34010 54055 FOR X=1 TO 24:POKE 54272+X,0 : NEXT 54060 GOTO34010 54300 IFSD=0THENSD=1:I$="":RETURN 54305 IFSD=1THENSD=0:I$="":RETURN 54310 RETURN 55100 FORI=828TO961:READD7:POKEI,D7:NEXT:RETURN 55110 DATA169,4,170,160,7,32,186,255,169,0,32,189,255,32,192,255,162,4,32,201 55120 DATA255,169,0,133,251,133,253,169,4,133,252 55125 DATA160,0,177,251,201,96,208,05,169,32,76,143,3,169,64,56,241,251,41,32 55130 DATA10,141,251,3,177,251,41,64,10,13,251,3,141,251,3,177,251,41,127,13,251 55140 DATA3,208,2,169,64,201,96,208,2,169,32,32,210,255,230,253,169,40,56,229,253 55150 DATA208,7,133,253,169,13,32,210,255,169,111,197,251,208,6,169,7,197,252,240 55160 DATA16,24,165,251,105,1,133,251,165,252,105,0,133,252,76,91,3,32,231,255,96 60000 PRINTCHR$(147):FORI=1TO6:PRINT:NEXT 60005 PRINTTAB(11)"[208]LEASE [215]AIT [215]ORKING" 60010 CLOSE15:OPEN15,8,15:PRINT#15,"I0" 60020 PRINT#15,"S0:"+TF$ 60025 PRINT#15,"S0:"+PN$ 60030 INPUT#15,ER$,EM$ 60032 POKE 808,237: REM === ENABLE RUN/STOP 60040 SAVE PN$,8:VERIFY PN$,8 60070 PRINT: PRINT "[217]OUR PROGRAM HAS BEEN SAVED ON YOUR" 60075 PRINT"APPLICATION DISK.":PRINT 60080 PRINT"[212]O RUN YOUR PROGRAM NOW, TYPE 'RUN'."